home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
CAD
/
PKEY11_1.ARJ
/
KY.BAK
< prev
next >
Wrap
Text File
|
1992-03-14
|
2KB
|
72 lines
;Add a key note to your drawing (handy)
;
; ********Patrick J. McKee, author********
; ****Copyright 1992, Power Key tm****
;
(defun kyerr (s)
(if (/= s "Function cancelled")(princ (strcat "\nError: " s)))
(setq rw *rw)
(setq tg *tg)
(setq kb *kb)
(setvar "orthomode" OM)
(setq *error* olderr)
(princ))
(defun dtr (angg)
(* pi (/ angg 180.0)))
(setq olderr *error* *error* kyerr)
(if (= *rw nil)(setq *rw "A")
(setq rw *rw))
(if (= *tg nil)(setq *tg "S")
(setq tg *tg))
(if (= *kb nil)(setq *kb "R")
(setq kb *kb))
(setq OM(getvar"orthomode"))
(IF (= scf nil)(SETQ SCF (GETREAL "\nENTER SCALE FACTOR FOR THIS SHEET: "))
(SETQ *SCF SCF))
(SETQ arw(GETSTRING (STRCAT "\n(A)rch. arrow. (D)im arrow. Do(T). < ")
(PROMPT *rw)
(prompt "\ >")
(princ)))
(if(= arw "")(setq arw *rw)(setq *rw arw))
(IF(OR(= arw "A")(= arw "a"))(SETQ arw "aarw"))
(IF(OR(= arw "D")(= arw "d"))(SETQ arw "darw"))
(IF(OR(= arw "T")(= arw "t"))(SETQ arw "dota"))
(SETQ TAG
(GETSTRING(strcat"\n(H)ex. (C)ircle. (S)quare. (E)llipse.(Tr)iangle.< ")
(prompt *tg)
(prompt "\ >")
(princ)))
(if(= tag "")(setq tag *tg)(setq *tg tag))
(IF(OR(= tag "H")(= tag "h"))(SETQ tag "hex"))
(IF(OR(= tag "S")(= tag "s"))(SETQ tag "sqr"))
(IF(OR(= tag "C")(= tag "c"))(SETQ tag "cir"))
(IF(OR(= tag "E")(= tag "e"))(SETQ tag "ell"))
(IF(OR(= tag "TR")(= tag "tr"))(SETQ tag "tri"))
(SETQ KBLK
(GETSTRING(strcat"\nKEYNOTE (R)IGHT. (L)EFT. (T)OP. (B)OTTOM. < ")
(prompt *kb)
(prompt "\ >")
(princ)))
(if(= kblk "")(setq kblk *kb)(setq *kb kblk))
(IF(OR(= KBLK "R")(= KBLK "r"))(SETQ KBLK (strcat tag "R")))
(IF(OR(= KBLK "B")(= KBLK "b"))(SETQ KBLK (strcat tag "B")))
(IF(OR(= KBLK "L")(= KBLK "l"))(SETQ KBLK (strcat tag "L")))
(IF(OR(= KBLK "T")(= KBLK "t"))(SETQ KBLK (strcat tag "T")))
(setq kt(getstring T "\nEnter keynote number : "))
(setq FP(getpoint "\nPick leader startpoint : "))
(setvar "orthomode" 0)
(setq SP(getpoint FP "\nsecond point: "))
(command "line" fp sp "")
(setvar "orthomode" 1)
(setq EP(getpoint sp "\nend point: "))
(IF(= EP NIL)(SETQ EP SP))
(setq a1(angle fp sp))
(setq a2(* a1 57.2958))
(setq arw1(strcat "d:/kesym1/" arw))
(command"insert" arw1 fp scf "" a2)
(command"line" sp ep "")
(command"insert" KBLK ep SCF "" "0" kt)
(setvar "orthomode" om)
(setq fp nil sp nil ep nil a1 nil a2 nil arw1 nil kt nil kblk1 nil)
(setq *error* olderr)
(princ)